Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/EDITORS/AE170.ZIP;1/AE1.PAS

Pascal/Delphi Source File | 1992-08-12 | 26.7 KB | 766 lines

UNIT AE1 ;

{$R-}
{$B-}
{$I-}
{$S+}
{$V-}

{-----------------------------------------------------------------------------}
{ This unit contains all basic procedures                                     }
{-----------------------------------------------------------------------------}

INTERFACE

USES Crt, Dos, AE0 ;

FUNCTION UpperCase (S : STRING) : STRING ;
FUNCTION WordToString (Num : WORD ; Len : INTEGER) : STRING ;
FUNCTION Wildcarded (Name : PathStr) : BOOLEAN ;
FUNCTION Exists (FileName : PathStr) : BOOLEAN ;
PROCEDURE MoveToScreen (VAR Source, Dest ; Len : WORD) ;
PROCEDURE MoveFromScreen (VAR Source, Dest ; Len : WORD) ;
PROCEDURE SaveArea (X1, Y1, X2, Y2 : WORD ; VAR MemPtr : ScreenBlockPtr) ;
PROCEDURE RestoreArea (X1, Y1, X2, Y2 : WORD ; VAR MemPtr : ScreenBlockPtr) ;
FUNCTION Grow (Index : WORD ; Chars : WORD) : BOOLEAN ;
PROCEDURE Shrink (Index : WORD ; Chars : WORD) ;
FUNCTION GetCursor : BYTE ;
PROCEDURE SetCursor (Cursor : BYTE) ;
PROCEDURE CursorTo (X, Y : BYTE) ;
PROCEDURE WarningBeep ;
FUNCTION ReadKeyNr : WORD ;
PROCEDURE SetBottomLine (LineText : STRING) ;
PROCEDURE Message (Contents : STRING) ;
PROCEDURE ErrorMessage (ErrorNr : BYTE) ;
PROCEDURE Pause ;
PROCEDURE CheckDiskError ;
PROCEDURE PutFrame (X1, Y1, X2, Y2 : BYTE ; Border : STRING) ;
PROCEDURE ClearArea (X1, Y1, X2, Y2 : BYTE) ;
PROCEDURE ClearCurrentWs ;
PROCEDURE ClearKeyBuffer ;
PROCEDURE CheckEsc ;
PROCEDURE CreateHistory (VAR Hp : HistPtr ; LineLen : BYTE) ;
PROCEDURE AddToHistory (Hp : HistPtr ; S : STRING) ;
FUNCTION CurrentHistLine (Hp : HistPtr) : STRING ;
FUNCTION NextHistLine (Hp : HistPtr) : STRING ;
FUNCTION PrevHistLine (Hp : HistPtr) : STRING ;
FUNCTION LeftMargin (VAR P : Position) : WORD ;
{$IFDEF DEVELOP }
PROCEDURE GetMem (VAR P : pointer ; Size : WORD ) ;
{$ENDIF }

IMPLEMENTATION

{-----------------------------------------------------------------------------}
{ Converts all lower case letters in a string to upper case.                  }
{-----------------------------------------------------------------------------}

FUNCTION UpperCase (S : STRING) : STRING ;

VAR Counter : WORD ;

BEGIN
FOR Counter := 1 TO LENGTH (S) DO S [Counter] := UPCASE (S [Counter]) ;
UpperCase := S ;
END ;

{-----------------------------------------------------------------------------}
{ Converts an expression of type word to a string                             }
{ if Len < 0 then string is adjusted to the left; string length is <Len>      }
{ if Len > 0 then string is adjusted to the right; string length is <-Len>    }
{ if Len = 0 then string is not adjusted; string has minimum length           }
{-----------------------------------------------------------------------------}

FUNCTION WordToString (Num : WORD ; Len : INTEGER) : STRING ;

VAR S : STRING [5] ;

BEGIN
IF Len > 0
   THEN STR (Num : Len, S)
   ELSE BEGIN
        STR (Num, S) ;
        Len := - Len ;
        IF (Len > 0) AND (LENGTH (S) < Len)
           THEN BEGIN
                FILLCHAR (S [LENGTH (S) + 1], Len - LENGTH (S), ' ') ;
                S [0] := CHR (Len) ;
                END ;
        END ;
WordToString := S ;
END ;

{-----------------------------------------------------------------------------}
{ Deletes all spaces on the left of a string.                                 }
{-----------------------------------------------------------------------------}

FUNCTION TrimLeft (S : STRING) : STRING ;

BEGIN
WHILE (LENGTH (S) > 0) AND (S [1] = ' ') DO DELETE (S, 1, 1) ;
TrimLeft := S ;
END ;

{-----------------------------------------------------------------------------}
{ Indicates whether a filename contains wildcard characters                   }
{-----------------------------------------------------------------------------}

FUNCTION Wildcarded (Name : PathStr) : BOOLEAN ;

BEGIN
Wildcarded := (POS ('*', Name) <> 0) OR (POS ('?', Name) <> 0) ;
END ;

{-----------------------------------------------------------------------------}
{ Returns True if the file <FileName> exists, False otherwise.                }
{-----------------------------------------------------------------------------}

FUNCTION Exists (FileName : PathStr) : BOOLEAN ;

VAR SR : SearchRec ;

BEGIN
FINDFIRST (FileName, ReadOnly + Hidden + SysFile, SR) ;
Exists := (DosError = 0) AND (NOT Wildcarded (Filename) ) ;
END ;

{-----------------------------------------------------------------------------}
{ Moves <Len> bytes of memory to screen memory.                               }
{ From the TCALC spreadsheet program delivered with every copy of Turbo       }
{ Pascal 5.5                                                                  }
{-----------------------------------------------------------------------------}

PROCEDURE MoveToScreen (VAR Source, Dest ; Len : WORD) ;

EXTERNAL ;

{-----------------------------------------------------------------------------}
{ Moves <Len> bytes of screen memory to memory.                               }
{ From the TCALC spreadsheet program delivered with every copy of Turbo       }
{ Pascal 5.5                                                                  }
{-----------------------------------------------------------------------------}

PROCEDURE MoveFromScreen (VAR Source, Dest ; Len : WORD) ;

EXTERNAL ;

{$L TCMVSMEM.OBJ }

{-----------------------------------------------------------------------------}
{ Saves the contents of a rectangular part of the screen to memory.           }
{ Upper left corner is (X1,Y1), lower right is (X2,Y2)                        }
{ Also claims the amount of memory needed.                                    }
{-----------------------------------------------------------------------------}

PROCEDURE SaveArea (X1, Y1, X2, Y2 : WORD ; VAR MemPtr : ScreenBlockPtr) ;

VAR LineLen : BYTE;
    Index : WORD;
    Counter : BYTE;

BEGIN
LineLen := X2 - X1 + 1;
GETMEM (POINTER(MemPtr), LineLen * (Y2 - Y1 + 1) * 2) ;
Index := 1 ;
FOR Counter := Y1 TO Y2 DO
    BEGIN
    MoveFromScreen (DisplayPtr^ [Counter, X1], MemPtr^ [Index], LineLen * 2);
    INC (Index, LineLen)
    END;
END;

{-----------------------------------------------------------------------------}
{ Reverse of SaveArea                                                         }
{-----------------------------------------------------------------------------}

PROCEDURE RestoreArea (X1, Y1, X2, Y2 : WORD ; VAR MemPtr : ScreenBlockPtr) ;

VAR LineLen : BYTE;
    Index : WORD;
    Counter : BYTE;

BEGIN
LineLen := X2 - X1 + 1;
Index := 1;
FOR Counter := Y1 TO Y2 DO
    BEGIN
    MoveToScreen (MemPtr^ [Index], DisplayPtr^ [Counter, X1], LineLen * 2);
    INC (Index, LineLen)
    END;
FREEMEM (MemPtr, LineLen * (Y2 - Y1 + 1) * 2) ;
END;

{-----------------------------------------------------------------------------}
{ Expands the text in the buffer of the current workspace at position         }
{ <Index> by <Chars> characters. Function result is False if there is not     }
{ enough space left, True otherwise.                                          }
{ Index values of Mark and in position stack are adapted                      }
{-----------------------------------------------------------------------------}

FUNCTION Grow (Index : WORD ; Chars : WORD) : BOOLEAN ;

VAR Counter : BYTE ;

BEGIN
WITH CurrentWs DO
     IF Chars > (WsBufSize - BufferSize)
        THEN BEGIN
             { not enough space }
             ErrorMessage (1) ;
             Grow := FALSE ;
             END
        ELSE BEGIN
             { move rest of text forward }
             MOVE (Buffer^ [Index], Buffer^ [Index + Chars], BufferSize - Index + 1) ;
             INC (BufferSize, Chars) ;
             { adapt Mark and position stack }
             IF MARK >= Index THEN INC (MARK, Chars) ;
             FOR Counter := 1 TO PosStackpointer DO
                 BEGIN
                 IF PosStack [Counter] >= Index
                    THEN INC (PosStack [Counter], Chars) ;
                 END ;
             ChangesMade := TRUE ;
             Grow := TRUE ;
             END ;
END ;

{-----------------------------------------------------------------------------}
{ Deletes <Chars> characters from the buffer in the current workspace,        }
{ starting on position <Index>.                                               }
{ Index values of Mark and in position stack are adapted                      }
{-----------------------------------------------------------------------------}

PROCEDURE Shrink (Index : WORD ; Chars : WORD) ;

VAR Counter : WORD ;

BEGIN
WITH CurrentWs DO
     BEGIN
     { move rest of text backward }
     MOVE (Buffer^ [Index + Chars], Buffer^ [Index], BufferSize - (Index + Chars) + 1) ;
     DEC (BufferSize, Chars) ;
     { adapt Mark }
     IF (MARK >= Index)
        THEN BEGIN
             IF (MARK < (Index + Chars) )
                THEN MARK := Inactive
                ELSE DEC (MARK, Chars) ;
             END ;
     { adapt position stack }
     FOR Counter := 1 TO PosStackpointer DO
         IF (PosStack [Counter] >= Index)
            THEN BEGIN
                 IF (PosStack [Counter] < (Index + Chars) )
                    THEN PosStack [Counter] := Index
                    ELSE DEC (PosStack [Counter], Chars) ;
                 END ;
     ChangesMade := TRUE ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Returns the current cursor type                                             }
{-----------------------------------------------------------------------------}

FUNCTION GetCursor : BYTE ;

VAR Reg : REGISTERS ;

BEGIN
WITH Reg DO
     BEGIN
     AH := 3 ;
     BH := 0 ;
     { call BIOS interrupt }
     INTR ($10, Reg) ;
     CASE CX OF
          $0607, $0B0C : GetCursor := UnderLineCursor ;
          $0507, $090C : GetCursor := HalfBlockCursor ;
          $0807, $0D0C : GetCursor := BlockCursor ;
          $2000       : GetCursor := Inactive ;
          $2001       : GetCursor := NoBlinkCursor ;
          ELSE          GetCursor := UnderLineCursor ;
          END ; { of case }
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Sets a new cursor                                                           }
{-----------------------------------------------------------------------------}

PROCEDURE SetCursor (Cursor : BYTE) ;

VAR Reg : REGISTERS ;
    ScrEl : ScreenElement ;

BEGIN
WITH Reg DO
     BEGIN
     AH := 1 ;
     BH := 0 ;
     { monochrome and color cards require different settings for cursor shape }
     CASE Cursor OF
          Inactive        : CX := $2000 ;
          UnderLineCursor : IF Colorcard THEN CX := $0607 ELSE CX := $0B0C ;
          HalfBlockCursor : IF Colorcard THEN CX := $0507 ELSE CX := $090C;
          BlockCursor     : IF Colorcard THEN CX := $0807 ELSE CX := $0D0C ;
          NoBlinkCursor   : CX := $2001 ;
          END ; { of case }
     { call BIOS interrupt }
     INTR ($10, Reg) ;
     END ; { with }
IF Cursor = NoBlinkCursor
   THEN BEGIN
        { put NoBlinkCursor on new position }
        ScrEl := ScreenElement (DisplayPtr^ [WHEREY, WHEREX]) ;
        { set cursor attribute }
        WITH ScreenColorArray [Config.Setup.ScreenColors] DO
             IF WHEREY = LinesOnScreen
                THEN ScrEl.Attribute := CursorAttr
                ELSE ScrEl.Attribute := StatusCursorAttr ;
        DisplayPtr^ [WHEREY, WHEREX] := WORD (ScrEl) ;
        END ;
END ;

{-----------------------------------------------------------------------------}
{ Positions the cursor at (X,Y)                                               }
{-----------------------------------------------------------------------------}

PROCEDURE CursorTo (X, Y : BYTE) ;

VAR ScrEl : ScreenElement ;

BEGIN
GOTOXY (X, Y) ;
IF Config.Setup.CursorType = NoBlinkCursor
   THEN BEGIN
        { put NoBlinkCursor on new position }
        ScrEl := ScreenElement (DisplayPtr^ [Y, X]) ;
        { set cursor attribute }
        WITH ScreenColorArray [Config.Setup.ScreenColors] DO
             IF WHEREY = LinesOnScreen
                THEN ScrEl.Attribute := StatusCursorAttr
                ELSE ScrEl.Attribute := CursorAttr ;
        DisplayPtr^ [Y, X] := WORD (ScrEl) ;
        END ;
END ;

{-----------------------------------------------------------------------------}
{ Produces a low beep trough the speaker, unless inhibited by Setup           }
{-----------------------------------------------------------------------------}

PROCEDURE WarningBeep ;

BEGIN
IF Config.Setup.SoundBell
   THEN BEGIN
        SOUND (110) ;
        DELAY (100) ;
        NOSOUND ;
        END ;
END ;

{-----------------------------------------------------------------------------}
{ Waits until a key on the keyboard is pressed and returns its key number.    }
{ Control keys (cursor keys, function keys etc.) are translated to numbers    }
{ above 255.                                                                  }
{-----------------------------------------------------------------------------}

FUNCTION ReadKeyNr : WORD ;

VAR Regs : REGISTERS ;

BEGIN
WITH Regs DO
     BEGIN
     AH := 0 ;
     INTR ($16, Regs) ;
     { AL now contains the ASCII value of the key, AH the scan code }
     CASE AL OF
           0 : IF AH = 3  THEN ReadKeyNr := 0    { ^@ }
                          ELSE ReadKeyNr := 256 + AH ;
           8 : IF AH = 14 THEN ReadKeyNr := BkspKey
                          ELSE ReadKeyNr := 8 ;  { ^H }
           9 : IF AH = 15 THEN ReadKeyNr := TabKey
                          ELSE ReadKeyNr := 9 ;  { ^I }
          10 : IF AH = 28 THEN ReadKeyNr := CtrlReturnKey
                          ELSE ReadKeyNr := 10 ; { ^J }
          13 : IF AH = 28 THEN ReadKeyNr := ReturnKey
                          ELSE ReadKeyNr := 13 ; { ^M }
          27 : IF AH = 1  THEN ReadKeyNr := EscapeKey
                          ELSE ReadKeyNr := 27 ; { ^[ }
          ELSE ReadKeyNr := AL ;
          END ; { of case }
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Puts a line of text on the last line of the screen.                         }
{ Writes directly into video memory.                                          }
{-----------------------------------------------------------------------------}

PROCEDURE SetBottomLine (LineText : STRING) ;

VAR ScrEl : ScreenElement ;
    ScrElPtr : ScreenElementPtr ;
    Col : BYTE ;

BEGIN
ScrElPtr := ScreenElementPtr (StatusLinePtr) ;
{ set attribute }
ScrEl.Attribute := ScreenColorArray [Config.Setup.ScreenColors].StatusAttr ;
{ fill first part of status line with LineText }
FOR Col := 1 TO LENGTH (LineText) DO
    BEGIN
    ScrEl.Contents := LineText [Col] ;
    ScrElPtr.Ref^ := ScrEl ;
    INC (ScrElPtr.OFS, 2) ;
    END ;
{ fill rest of status line with spaces }
ScrEl.Contents := ' ' ;
FOR Col := (LENGTH (LineText) + 1) TO ColsOnScreen DO
    BEGIN
    ScrElPtr.Ref^ := ScrEl ;
    INC (ScrElPtr.OFS, 2) ;
    END ;
END ;

{-----------------------------------------------------------------------------}
{ Produces a message on the last line of the screen and sets MessageRead      }
{-----------------------------------------------------------------------------}

PROCEDURE Message (Contents : STRING) ;

BEGIN
SetBottomLine (Contents) ;
MessageRead := (LENGTH (Contents) = 0) ;
END ;

{-----------------------------------------------------------------------------}
{ Produces an error beep (if allowed by Setup), writes an error message       }
{ corresponding to the error number, on the last screen line and waits        }
{ until the Escape key is pressed.                                            }
{ If any macros are running, they are canceled.                               }
{-----------------------------------------------------------------------------}

PROCEDURE ErrorMessage (ErrorNr : BYTE) ;

VAR ErrorText : STRING [ColsOnScreen] ;

BEGIN
IF Config.Setup.SoundBell
   THEN BEGIN
        SOUND (880) ;
        DELAY (100) ;
        NOSOUND ;
        END ;
CASE ErrorNr OF
       1 : ErrorText := 'Not enough memory' ;
       4 : ErrorText := 'Block too large for paste buffer' ;
       5 : ErrorText := 'No block defined' ;
       6 : ErrorText := 'Maximum macro length reached. End of define mode' ;
       7 : ErrorText := 'File too large. Only partially read' ;
       8 : ErrorText := 'File not found' ;
       9 : ErrorText := 'Cyclic macro definition. Key ignored' ;
      10 : ErrorText := 'Too many macros nested. Execution canceled' ;
      11 : ErrorText := 'Word wrap mode must be on to do this' ;
      12 : ErrorText := 'Position stack full' ;
      13 : ErrorText := 'Position stack empty' ;
      14 : CASE DosError OF
                2  : ErrorText := 'Can not find COMMAND.COM ' ;
                8  : ErrorText := 'Not enough memory to execute DOS command' ;
                ELSE ErrorText := 'DOS error ' + WordToString (DosError, 2) ;
                END ; { of case }
      15 : ErrorText := 'String not found' ;
      16 : ErrorText := 'Illegal file name' ;
      17 : CASE DiskError OF
                2   : ErrorText := 'File not found' ;
                3   : ErrorText := 'Path not found' ;
                5   : ErrorText := 'File access denied' ;
                100 : ErrorText := 'Disk read error' ;
                101 : ErrorText := 'Disk write error' ;
                103 : ErrorText := 'File not open' ;
                150 : ErrorText := 'Disk is write-protected' ;
                152 : ErrorText := 'Drive not ready' ;
                159 : ErrorText := 'Printer out of paper' ;
                160 : ErrorText := 'Device write fault' ;
                ELSE  ErrorText := 'I/O error ' + WordToString (DiskError, 0) ;
                END ; { of case }
      18 : ErrorText := 'Macro execution interrupted' ;
      19 : ErrorText := 'Bad or incompatible configuration file. Using default' ;
      20 : ErrorText := 'Please enter a number' ;
      21 : ErrorText := 'Number is too low' ;
      22 : ErrorText := 'Number is too high' ;
      23 : ErrorText := 'Bad or incompatible work file' ;
      END ; { of case }
SetBottomLine (ErrorText + ' (press Esc)') ;
REPEAT UNTIL ReadKeyNr = EscapeKey ;
IF MacroStackpointer <> Inactive
   THEN BEGIN
        MacroStackpointer := Inactive ;
        Message ('Macro execution canceled') ;
        END
   ELSE Message ('') ;
END ;

{-----------------------------------------------------------------------------}
{ Like the DOS batch command, Pause displays the message 'Press any key to    }
{ continue' and then waits until a key is pressed.                            }
{-----------------------------------------------------------------------------}

PROCEDURE Pause ;

VAR DummyKey : WORD ;

BEGIN
SetBottomLine ('Press any key to continue') ;
DummyKey := ReadKeyNr ;
EscPressed := (DummyKey = EscapeKey) ;
SetBottomLine ('') ;
END ;

{-----------------------------------------------------------------------------}
{ Reads the result of the last I/O operation into the DiskError variable      }
{ and produces an error message if an error has occurred.                     }
{-----------------------------------------------------------------------------}

PROCEDURE CheckDiskError ;

BEGIN
DiskError := IORESULT ;
IF DiskError <> 0 THEN ErrorMessage (17) ;
END ;

{-----------------------------------------------------------------------------}
{ Draws a frame on the text screen between (X1,Y1) and (X2,Y2)                }
{-----------------------------------------------------------------------------}

PROCEDURE PutFrame (X1, Y1, X2, Y2 : BYTE ; Border : STRING) ;

VAR i : BYTE ;

BEGIN
CursorTo (X1, Y1) ; WRITE (Border [1]) ; { upper left corner }
FOR i := SUCC (X1) TO PRED (X2) DO WRITE (Border [2]) ; { upper side }
WRITE (Border [3]) ; { upper right corner }
FOR i := SUCC (Y1) TO PRED (Y2) DO
    BEGIN
    CursorTo (X1, i) ; WRITE (Border [8]) ; { left side }
    CursorTo (X2, i) ; WRITE (Border [4]) ; { right side }
    END ;
CursorTo (X1, Y2) ; WRITE (Border [7]) ; { lower right corner }
FOR i := SUCC (X1) TO PRED (X2) DO WRITE (Border [6]) ; { lower side }
WRITE (Border [5]) ; { lower left corner }
END ;

{-----------------------------------------------------------------------------}
{ Clears a rectangular screen area between (X1,Y1) and (X2,Y2).               }
{-----------------------------------------------------------------------------}

PROCEDURE ClearArea (X1, Y1, X2, Y2 : BYTE) ;

VAR OldWindMax, OldWindMin : WORD ;

BEGIN
OldWindMax := WindMax ;
OldWindMin := WindMin ;
WINDOW (X1, Y1, X2, Y2) ;
CLRSCR ;
WINDOW (LO (OldWindMin) + 1, HI (OldWindMin) + 1,
        LO (OldWindMax) + 1, HI (OldWindMax) + 1) ;
END ;

{-----------------------------------------------------------------------------}
{ Clears the current workspace, resetting all variables.                      }
{-----------------------------------------------------------------------------}

PROCEDURE ClearCurrentWs ;

BEGIN
WITH Workspace [CurrentWsnr] DO
     BEGIN
     Name := '' ;
     ChangesMade := FALSE ;
     GETTIME (LastTimeSaved [1], LastTimeSaved [2],
              LastTimeSaved [3], LastTimeSaved [4]) ;
     CurPos.Index := 1 ;
     CurPos.Linenr := 1 ;
     CurPos.Colnr := 1 ;
     MARK := Inactive ;
     FirstVisibleLine := CurPos ;
     FirstScreenCol := 1 ;
     VirtualColnr := 1 ;
     Buffer^ [1] := EF ;
     Buffersize := 1 ;
     PosStackPointer := Inactive ;
     END ;
{ make copy of current workspace equal to original }
CurrentWs := Workspace [CurrentWsnr] ;
END ;

{-----------------------------------------------------------------------------}
{ Clears the keys in the keyboard buffer.                                     }
{-----------------------------------------------------------------------------}

PROCEDURE ClearKeyBuffer ;

VAR DummyKey : CHAR ;

BEGIN
WHILE KEYPRESSED DO DummyKey := READKEY ;
END ;

{-----------------------------------------------------------------------------}
{ Checks if the Escape key has been pressed                                   }
{-----------------------------------------------------------------------------}

PROCEDURE CheckEsc ;

BEGIN
EscPressed := FALSE ;
WHILE KEYPRESSED DO
      IF READKEY = ESC THEN EscPressed := TRUE ;
END ;

{-----------------------------------------------------------------------------}
{ Creates an empty history with lines of <LineLen> chars long                 }
{-----------------------------------------------------------------------------}

PROCEDURE CreateHistory (VAR Hp : HistPtr ; LineLen : BYTE) ;

VAR i : BYTE ;

BEGIN
NEW (Hp) ;
FOR i := 1 TO MaxHistLength DO
    GETMEM (POINTER(Hp^.LINE [i]), LineLen + 1) ;
Hp^.MaxLineLen := LineLen ;
Hp^.Len := 0 ;
Hp^.CurLine := 0 ;
END ;

{-----------------------------------------------------------------------------}
{ Adds a new string to a history, unless already present                      }
{-----------------------------------------------------------------------------}

PROCEDURE AddToHistory (Hp : HistPtr ; S : STRING) ;

VAR i,j : BYTE ;

BEGIN
WITH Hp^ DO
     BEGIN
     { check if line already present in history }
     i := 1 ;
     WHILE (i < Len ) AND (S <> LINE [i]^) DO
           INC (i) ;
     IF (Len > 0) AND (S = LINE[i]^)
        THEN BEGIN
             { move this line to top of history }
             FOR j := i TO (Len-1) DO
                 LINE[j]^ := LINE[j+1]^ ;
             LINE[Len]^ := S ;
             END
        ELSE BEGIN
             { add line to end of history }
             IF Len < MaxHistLength
                THEN { expand history }
                     INC (Len)
                ELSE { history full: shift lines, losing the oldest one }
                     FOR i := 1 TO (Len - 1) DO
                         LINE [i]^ := LINE [i + 1]^ ;
             LINE [Len]^ := COPY (S, 1, MaxLineLen) ;
             END ;
     { set current line so that next PrevHistLine returns this line }
     CurLine := 0 ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Returns the current history line                                            }
{-----------------------------------------------------------------------------}

FUNCTION CurrentHistLine (Hp : HistPtr) : STRING ;

BEGIN
WITH Hp^ DO
     IF (Len = 0) OR (CurLine = 0)
        THEN CurrentHistLine := ''
        ELSE CurrentHistLine := LINE [CurLine]^ ;
END ;

{-----------------------------------------------------------------------------}
{ Returns the history line above the current one                              }
{-----------------------------------------------------------------------------}

FUNCTION NextHistLine (Hp : HistPtr) : STRING ;

BEGIN
WITH Hp^ DO
     BEGIN
     IF CurLine = Len
        THEN CurLine := 0
        ELSE INC (CurLine) ;
     NextHistLine := CurrentHistLine (Hp) ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Returns the history line below the current one                              }
{-----------------------------------------------------------------------------}

FUNCTION PrevHistLine (Hp : HistPtr) : STRING ;

BEGIN
WITH Hp^ DO
     BEGIN
     IF CurLine = 0
        THEN CurLine := Len
        ELSE DEC (CurLine) ;
     PrevHistLine := CurrentHistLine (Hp) ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Determines the left margin of the current line. Position P must be after    }
{ the first non-space, otherwise the result is 1.                             }
{-----------------------------------------------------------------------------}

FUNCTION LeftMargin (VAR P : Position) : WORD ;

VAR Counter : WORD ;

BEGIN
WITH CurrentWs DO
     BEGIN
     { look for first non-space on current line }
     Counter := 1 ;
     WHILE (Buffer^ [P.Index - P.Colnr + Counter] = ' ') AND
           (Counter <= P.Colnr) DO
           INC (Counter) ;
     IF (Counter > P.Colnr)
        THEN LeftMargin := 1
        ELSE LeftMargin := Counter ;
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ GetMem is redirected, to keep track of available memory.                    }
{-----------------------------------------------------------------------------}

{$IFDEF DEVELOP }
PROCEDURE GetMem (VAR P : pointer ; Size : WORD ) ;

BEGIN
System.GetMem (P, Size) ;
IF MEMAVAIL < MinMemAvail
   THEN MinMemAvail := MEMAVAIL ;
END ;
{$ENDIF }

{-----------------------------------------------------------------------------}

END.